home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ANSI.SWG / 0007_CRT Clone with ANSI.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  8KB  |  226 lines
  1. {
  2.  Well here it is again, its a little rough and some of the Crt.tpu Functions
  3. are left out. This Unit will generate Ansi TextColor and TextBackGrounds.
  4. Becuase of the Ansi screen Writes you can send the Program to the com port
  5. just by using CTTY or GateWay in a bat File before you start your Program.
  6. }
  7.  
  8. Unit Crtclone;
  9.  
  10. Interface
  11.  
  12. Const
  13. { Foreground and background color Constants }
  14.  
  15.   Black         = 0;
  16.   Blue          = 1;
  17.   Green         = 2;
  18.   Cyan          = 3;
  19.   Red           = 4;
  20.   Magenta       = 5;
  21.   Brown         = 6;
  22.   LightGray     = 7;
  23.  
  24. { Foreground color Constants }
  25.  
  26.   DarkGray      = 8;
  27.   LightBlue     = 9;
  28.   LightGreen    = 10;
  29.   LightCyan     = 11;
  30.   LightRed      = 12;
  31.   LightMagenta  = 13;
  32.   Yellow        = 14;
  33.   White         = 15;
  34.  
  35. { Add-in For blinking }
  36.  
  37.   Blink         = 128;
  38.  
  39. Var
  40.  
  41. { Interface Variables }
  42.  
  43.   CheckBreak: Boolean;    { Enable Ctrl-Break }
  44.   CheckEOF: Boolean;      { Enable Ctrl-Z }
  45.   Procedure TextColor(Color: Byte);
  46.   Procedure TextBackground(Color: Byte);
  47.   Function KeyPressed  : Boolean;
  48.   Function GetKey      : Char;
  49.   Function ReadKey     : Char;
  50.   Function WhereX      : Byte;
  51.   Function WhereY      : Byte;
  52.   Procedure NormVideo;
  53.   Procedure ClrEol;
  54.   Procedure ClrScr;
  55.   Procedure GotoXY(X, Y : Byte);
  56.  
  57.  
  58.   Implementation
  59.  
  60.   Function KeyPressed : Boolean;   { Replacement For Crt.KeyPressed }
  61.                          {  ;Detects whether a key is pressed}
  62.                          {  ;Does nothing With the key}
  63.                          {  ;Returns True if key is pressed}
  64.                          {  ;Otherwise, False}
  65.                          {  ;Key remains in kbd buffer}
  66.     Var IsThere : Byte;
  67.     begin
  68.       Inline(
  69.       $B4/$0B/               {    MOV AH,+$0B         ;Get input status}
  70.       $CD/$21/               {    INT $21             ;Call Dos}
  71.       $88/$86/>ISTHERE);     {    MOV >IsThere[BP],AL ;Move into Variable}
  72.       if IsThere = $FF then KeyPressed := True else KeyPressed := False;
  73.     end;
  74.  
  75.   Procedure  ClrEol;     { ANSI replacement For Crt.ClrEol }
  76.     begin
  77.       Write(#27'[K');
  78.     end;
  79.  
  80.   Procedure ClrScr;     { ANSI replacement For Crt.ClrScr }
  81.     begin
  82.       Write(#27'[2J');
  83.     end;
  84.  
  85.   Function GetKey : Char;     { Additional Function.  Not in Crt Unit }
  86.     Var CH : Char;
  87.     begin
  88.       Inline(
  89.                      {; Function GetKey : Char}
  90.                      {; Clears the keyboard buffer then waits Until}
  91.                      {; a key is struck.  if the key is a special, e.g.}
  92.                      {; Function key, goes back and reads the next}
  93.                      {; Byte in the keyboard buffer.  Thus does}
  94.                      {; nothing special With Function keys.}
  95.        $B4/$0C       {       MOV  AH,$0C      ;Set up to clear buffer}
  96.       /$B0/$08       {       MOV  AL,8        ;then to get a Char}
  97.       /$CD/$21       {SPCL:  INT  $21         ;Call Dos}
  98.       /$3C/$00       {       CMP  AL,0        ;if it's a 0 Byte}
  99.       /$75/$04       {       JNZ  CHRDY       ;is spec., get second Byte}
  100.       /$B4/$08       {       MOV  AH,8        ;else set up For another}
  101.       /$EB/$F6       {       JMP  SHORT SPCL  ;and get it}
  102.       /$88/$46/>CH   {CHRDY: MOV  >CH[BP],AL  ;else put into Function return}
  103.        );
  104.       if CheckBreak and (Ch = #3) then
  105.         begin        {if CheckBreak is True and it's a ^C}
  106.           Inline(    {then execute Ctrl_Brk}
  107.           $CD/$23);
  108.         end;
  109.       GetKey := Ch;
  110.     end; {Inline Function GetKey}
  111.  
  112.  
  113.   Function ReadKey : Char;  { Replacement For Crt.ReadKey }
  114.     Var chrout : Char;
  115.     begin
  116.                          {  ;Just like ReadKey in Crt Unit}
  117.       Inline(
  118.       $B4/$07/               {  MOV AH,$07          ;Char input w/o echo}
  119.       $CD/$21/               {  INT $21             ;Call Dos}
  120.       $88/$86/>CHROUT);      {  MOV >chrout[bp],AL  ;Put into Variable}
  121.       if CheckBreak and (chrout = #3) then  {if it's a ^C and CheckBreak True}
  122.         begin                             {then execute Ctrl_Brk}
  123.           Inline(
  124.           $CD/$23);           {     INT $23}
  125.         end;
  126.       ReadKey := chrout;                    {else return Character}
  127.     end;
  128.  
  129.   Function WhereX : Byte;       { ANSI replacement For Crt.WhereX }
  130.     Var                         { Cursor position report. This is column or }
  131.       ch  : Char;               { X axis report.}
  132.       st  : String;
  133.       st1 : String[2];
  134.       x   : Byte;
  135.       i   : Integer;
  136.  
  137.     begin
  138.       Write(#27'[6n');          { Ansi String to get X-Y position }
  139.       st := '';                 { We will only use X here }
  140.       ch := #0;                 { Make sure Character is not 'R' }
  141.       While ch <> 'R' do        { Return will be }
  142.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  143.           ch := #0;
  144.           ch := ReadKey;        { Get one }
  145.           st := st + ch;        { Build String }
  146.         end;
  147.         St1 := copy(St,6,2);    { Pick off subString having number in ASCII}
  148.         Val(St1,x,i);           { Make it numeric }
  149.         WhereX := x;            { Return the number }
  150.     end;
  151.  
  152.   Function WhereY : Byte;       { ANSI replacement For Crt.WhereY }
  153.     Var                         { Cursor position report.  This is row or }
  154.       ch  : Char;               { Y axis report.}
  155.       st  : String;
  156.       st1 : String[2];
  157.       y   : Byte;
  158.       i   : Integer;
  159.  
  160.     begin
  161.       Write(#27'[6n');          { Ansi String to get X-Y position }
  162.       st := '';                 { We will only use Y here }
  163.       ch := #0;                 { Make sure Character is not 'R' }
  164.       While ch <> 'R' do        { Return will be }
  165.         begin                   { Esc - [ - Ypos - ; - Xpos - R }
  166.           ch := #0;
  167.           ch := ReadKey;        { Get one }
  168.           st := st + ch;        { Build String }
  169.         end;
  170.         St1 := copy(St,3,2);    { Pick off subString having number in ASCII}
  171.         Val(St1,y,i);           { Make it numeric }
  172.         WhereY := y;            { Return the number }
  173.     end;
  174.  
  175.  
  176.     Procedure GotoXY(x : Byte ; y : Byte); { ANSI replacement For Crt.GoToXY}
  177.       begin
  178.         if (x < 1) or (y < 1) then Exit;
  179.         if (x > 80) or (y > 25) then Exit;
  180.         Write(#27'[',y,';',x,'H');
  181.       end;
  182.  
  183.    Procedure TextBackGround(Color:Byte);
  184.     begin
  185.      Case color of
  186.           0: begin      Write(#27#91#52#48#109); end;
  187.           1: begin      Write(#27#91#52#52#109); end;
  188.           2: begin      Write(#27#91#52#50#109); end;
  189.           3: begin      Write(#27#91#52#54#109); end;
  190.           4: begin      Write(#27#91#52#49#109); end;
  191.           5: begin      Write(#27#91#52#53#109); end;
  192.           6: begin      Write(#27#91#52#51#109); end;
  193.           6: begin      Write(#27#91#52#55#109); end;
  194.      end;
  195.    end;
  196.  
  197.    Procedure TextColor(Color:Byte);
  198.      begin
  199.       Case color of
  200.          0: begin  Write(#27#91#51#48#109); end;
  201.          1: begin  Write(#27#91#51#52#109); end;
  202.          2: begin  Write(#27#91#51#50#109); end;
  203.          3: begin  Write(#27#91#51#54#109); end;
  204.          4: begin  Write(#27#91#51#49#109); end;
  205.          5: begin  Write(#27#91#51#53#109); end;
  206.          6: begin  Write(#27#91#51#51#109); end;
  207.          7: begin  Write(#27#91#51#55#109); end;
  208.          8: begin  Write(#27#91#49#59#51#48#109); end;
  209.          9: begin  Write(#27#91#49#59#51#52#109); end;
  210.         10: begin  Write(#27#91#49#59#51#50#109); end;
  211.         11: begin  Write(#27#91#49#59#51#54#109); end;
  212.         12: begin  Write(#27#91#49#59#51#49#109); end;
  213.         13: begin  Write(#27#91#49#59#51#53#109); end;
  214.         14: begin  Write(#27#91#49#59#51#51#109); end;
  215.         15: begin  Write(#27#91#49#59#51#55#109); end;
  216.        128: begin  Write(#27#91#53#109); end;
  217.       end;
  218.      end;
  219.  
  220.  Procedure NormVideo;
  221.       begin
  222.         Write(#27#91#48#109);
  223.       end;
  224.  
  225. end.
  226.